home *** CD-ROM | disk | FTP | other *** search
/ PC World Komputer 2010 April / PCWorld0410.iso / hity wydania / Ubuntu 9.10 PL / karmelkowy-koliberek-desktop-9.10-i386-PL.iso / casper / filesystem.squashfs / usr / share / tcltk / tk8.4 / clrpick.tcl < prev    next >
Text File  |  2009-04-29  |  21KB  |  697 lines
  1. # clrpick.tcl --
  2. #
  3. #    Color selection dialog for platforms that do not support a
  4. #    standard color selection dialog.
  5. #
  6. # RCS: @(#) $Id: clrpick.tcl,v 1.20.2.2 2006/03/17 10:50:11 patthoyts Exp $
  7. #
  8. # Copyright (c) 1996 Sun Microsystems, Inc.
  9. #
  10. # See the file "license.terms" for information on usage and redistribution
  11. # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  12. #
  13. # ToDo:
  14. #
  15. #    (1): Find out how many free colors are left in the colormap and
  16. #         don't allocate too many colors.
  17. #    (2): Implement HSV color selection. 
  18. #
  19.  
  20. # Make sure namespaces exist
  21. namespace eval ::tk {}
  22. namespace eval ::tk::dialog {}
  23. namespace eval ::tk::dialog::color {
  24.     namespace import ::tk::msgcat::*
  25. }
  26.  
  27. # ::tk::dialog::color:: --
  28. #
  29. #    Create a color dialog and let the user choose a color. This function
  30. #    should not be called directly. It is called by the tk_chooseColor
  31. #    function when a native color selector widget does not exist
  32. #
  33. proc ::tk::dialog::color:: {args} {
  34.     variable ::tk::Priv
  35.     set dataName __tk__color
  36.     upvar ::tk::dialog::color::$dataName data
  37.     set w .$dataName
  38.  
  39.     # The lines variables track the start and end indices of the line
  40.     # elements in the colorbar canvases.
  41.     set data(lines,red,start)   0
  42.     set data(lines,red,last)   -1
  43.     set data(lines,green,start) 0
  44.     set data(lines,green,last) -1
  45.     set data(lines,blue,start)  0
  46.     set data(lines,blue,last)  -1
  47.  
  48.     # This is the actual number of lines that are drawn in each color strip.
  49.     # Note that the bars may be of any width.
  50.     # However, NUM_COLORBARS must be a number that evenly divides 256.
  51.     # Such as 256, 128, 64, etc.
  52.     set data(NUM_COLORBARS) 16
  53.  
  54.     # BARS_WIDTH is the number of pixels wide the color bar portion of the
  55.     # canvas is. This number must be a multiple of NUM_COLORBARS
  56.     set data(BARS_WIDTH) 160
  57.  
  58.     # PLGN_WIDTH is the number of pixels wide of the triangular selection
  59.     # polygon. This also results in the definition of the padding on the 
  60.     # left and right sides which is half of PLGN_WIDTH. Make this number even.
  61.     set data(PLGN_HEIGHT) 10
  62.  
  63.     # PLGN_HEIGHT is the height of the selection polygon and the height of the 
  64.     # selection rectangle at the bottom of the color bar. No restrictions.
  65.     set data(PLGN_WIDTH) 10
  66.  
  67.     Config $dataName $args
  68.     InitValues $dataName
  69.  
  70.     set sc [winfo screen $data(-parent)]
  71.     set winExists [winfo exists $w]
  72.     if {!$winExists || $sc ne [winfo screen $w]} {
  73.     if {$winExists} {
  74.         destroy $w
  75.     }
  76.     toplevel $w -class TkColorDialog -screen $sc
  77.     BuildDialog $w
  78.     }
  79.  
  80.     # Dialog boxes should be transient with respect to their parent,
  81.     # so that they will always stay on top of their parent window.  However,
  82.     # some window managers will create the window as withdrawn if the parent
  83.     # window is withdrawn or iconified.  Combined with the grab we put on the
  84.     # window, this can hang the entire application.  Therefore we only make
  85.     # the dialog transient if the parent is viewable.
  86.  
  87.     if {[winfo viewable [winfo toplevel $data(-parent)]] } {
  88.     wm transient $w $data(-parent)
  89.     }
  90.  
  91.     # 5. Withdraw the window, then update all the geometry information
  92.     # so we know how big it wants to be, then center the window in the
  93.     # display and de-iconify it.
  94.  
  95.     ::tk::PlaceWindow $w widget $data(-parent)
  96.     wm title $w $data(-title)
  97.  
  98.     # 6. Set a grab and claim the focus too.
  99.  
  100.     ::tk::SetFocusGrab $w $data(okBtn)
  101.  
  102.     # 7. Wait for the user to respond, then restore the focus and
  103.     # return the index of the selected button.  Restore the focus
  104.     # before deleting the window, since otherwise the window manager
  105.     # may take the focus away so we can't redirect it.  Finally,
  106.     # restore any grab that was in effect.
  107.  
  108.     vwait ::tk::Priv(selectColor)
  109.     ::tk::RestoreFocusGrab $w $data(okBtn)
  110.     unset data
  111.  
  112.     return $Priv(selectColor)
  113. }
  114.  
  115. # ::tk::dialog::color::InitValues --
  116. #
  117. #    Get called during initialization or when user resets NUM_COLORBARS
  118. #
  119. proc ::tk::dialog::color::InitValues {dataName} {
  120.     upvar ::tk::dialog::color::$dataName data
  121.  
  122.     # IntensityIncr is the difference in color intensity between a colorbar
  123.     # and its neighbors.
  124.     set data(intensityIncr) [expr {256 / $data(NUM_COLORBARS)}]
  125.  
  126.     # ColorbarWidth is the width of each colorbar
  127.     set data(colorbarWidth) \
  128.         [expr {$data(BARS_WIDTH) / $data(NUM_COLORBARS)}]
  129.  
  130.     # Indent is the width of the space at the left and right side of the
  131.     # colorbar. It is always half the selector polygon width, because the
  132.     # polygon extends into the space.
  133.     set data(indent) [expr {$data(PLGN_WIDTH) / 2}]
  134.  
  135.     set data(colorPad) 2
  136.     set data(selPad)   [expr {$data(PLGN_WIDTH) / 2}]
  137.  
  138.     #
  139.     # minX is the x coordinate of the first colorbar
  140.     #
  141.     set data(minX) $data(indent)
  142.  
  143.     #
  144.     # maxX is the x coordinate of the last colorbar
  145.     #
  146.     set data(maxX) [expr {$data(BARS_WIDTH) + $data(indent)-1}]
  147.  
  148.     #
  149.     # canvasWidth is the width of the entire canvas, including the indents
  150.     #
  151.     set data(canvasWidth) [expr {$data(BARS_WIDTH) + $data(PLGN_WIDTH)}]
  152.  
  153.     # Set the initial color, specified by -initialcolor, or the
  154.     # color chosen by the user the last time.
  155.     set data(selection) $data(-initialcolor)
  156.     set data(finalColor)  $data(-initialcolor)
  157.     set rgb [winfo rgb . $data(selection)]
  158.  
  159.     set data(red,intensity)   [expr {[lindex $rgb 0]/0x100}]
  160.     set data(green,intensity) [expr {[lindex $rgb 1]/0x100}]
  161.     set data(blue,intensity)  [expr {[lindex $rgb 2]/0x100}]
  162. }
  163.  
  164. # ::tk::dialog::color::Config  --
  165. #
  166. #    Parses the command line arguments to tk_chooseColor
  167. #
  168. proc ::tk::dialog::color::Config {dataName argList} {
  169.     variable ::tk::Priv
  170.     upvar ::tk::dialog::color::$dataName data
  171.  
  172.     # 1: the configuration specs
  173.     #
  174.     if {[info exists Priv(selectColor)] && $Priv(selectColor) ne ""} {
  175.     set defaultColor $Priv(selectColor)
  176.     } else {
  177.     set defaultColor [. cget -background]
  178.     }
  179.  
  180.     set specs [list \
  181.         [list -initialcolor "" "" $defaultColor] \
  182.         [list -parent "" "" "."] \
  183.         [list -title "" "" [mc "Color"]] \
  184.         ]
  185.  
  186.     # 2: parse the arguments
  187.     #
  188.     tclParseConfigSpec ::tk::dialog::color::$dataName $specs "" $argList
  189.  
  190.     if {$data(-title) eq ""} {
  191.     set data(-title) " "
  192.     }
  193.     if {[catch {winfo rgb . $data(-initialcolor)} err]} {
  194.     error $err
  195.     }
  196.  
  197.     if {![winfo exists $data(-parent)]} {
  198.     error "bad window path name \"$data(-parent)\""
  199.     }
  200. }
  201.  
  202. # ::tk::dialog::color::BuildDialog --
  203. #
  204. #    Build the dialog.
  205. #
  206. proc ::tk::dialog::color::BuildDialog {w} {
  207.     upvar ::tk::dialog::color::[winfo name $w] data
  208.  
  209.     # TopFrame contains the color strips and the color selection
  210.     #
  211.     set topFrame [frame $w.top -relief raised -bd 1]
  212.  
  213.     # StripsFrame contains the colorstrips and the individual RGB entries
  214.     set stripsFrame [frame $topFrame.colorStrip]
  215.  
  216.     set maxWidth [::tk::mcmaxamp &Red &Green &Blue]
  217.     set maxWidth [expr {$maxWidth<6?6:$maxWidth}]
  218.     set colorList [list \
  219.         red        [mc "&Red"]    \
  220.         green    [mc "&Green"]    \
  221.         blue    [mc "&Blue"]    \
  222.         ]
  223.     foreach {color l} $colorList {
  224.     # each f frame contains an [R|G|B] entry and the equiv. color strip.
  225.     set f [frame $stripsFrame.$color]
  226.  
  227.     # The box frame contains the label and entry widget for an [R|G|B]
  228.     set box [frame $f.box]
  229.  
  230.     bind [::tk::AmpWidget label $box.label -text $l: -width $maxWidth \
  231.         -anchor ne] <<AltUnderlined>> [list focus $box.entry]
  232.     
  233.     entry $box.entry -textvariable \
  234.         ::tk::dialog::color::[winfo name $w]($color,intensity) \
  235.         -width 4
  236.     pack $box.label -side left -fill y -padx 2 -pady 3
  237.     pack $box.entry -side left -anchor n -pady 0
  238.     pack $box -side left -fill both
  239.  
  240.     set height [expr \
  241.         {[winfo reqheight $box.entry] - \
  242.         2*([$box.entry cget -highlightthickness] + [$box.entry cget -bd])}]
  243.  
  244.     canvas $f.color -height $height\
  245.         -width $data(BARS_WIDTH) -relief sunken -bd 2
  246.     canvas $f.sel -height $data(PLGN_HEIGHT) \
  247.         -width $data(canvasWidth) -highlightthickness 0
  248.     pack $f.color -expand yes -fill both
  249.     pack $f.sel -expand yes -fill both
  250.  
  251.     pack $f -side top -fill x -padx 0 -pady 2
  252.  
  253.     set data($color,entry) $box.entry
  254.     set data($color,col) $f.color
  255.     set data($color,sel) $f.sel
  256.  
  257.     bind $data($color,col) <Configure> \
  258.         [list tk::dialog::color::DrawColorScale $w $color 1]
  259.     bind $data($color,col) <Enter> \
  260.         [list tk::dialog::color::EnterColorBar $w $color]
  261.     bind $data($color,col) <Leave> \
  262.         [list tk::dialog::color::LeaveColorBar $w $color]
  263.  
  264.     bind $data($color,sel) <Enter> \
  265.         [list tk::dialog::color::EnterColorBar $w $color]
  266.     bind $data($color,sel) <Leave> \
  267.         [list tk::dialog::color::LeaveColorBar $w $color]
  268.  
  269.     bind $box.entry <Return> [list tk::dialog::color::HandleRGBEntry $w]
  270.     }
  271.  
  272.     pack $stripsFrame -side left -fill both -padx 4 -pady 10
  273.  
  274.     # The selFrame contains a frame that demonstrates the currently
  275.     # selected color
  276.     #
  277.     set selFrame [frame $topFrame.sel]
  278.     set lab [::tk::AmpWidget label $selFrame.lab -text [mc "&Selection:"] \
  279.         -anchor sw]
  280.     set ent [entry $selFrame.ent \
  281.     -textvariable ::tk::dialog::color::[winfo name $w](selection) \
  282.     -width 16]
  283.     set f1  [frame $selFrame.f1 -relief sunken -bd 2]
  284.     set data(finalCanvas) [frame $f1.demo -bd 0 -width 100 -height 70]
  285.  
  286.     pack $lab $ent -side top -fill x -padx 4 -pady 2
  287.     pack $f1 -expand yes -anchor nw -fill both -padx 6 -pady 10
  288.     pack $data(finalCanvas) -expand yes -fill both
  289.  
  290.     bind $ent <Return> [list tk::dialog::color::HandleSelEntry $w]
  291.  
  292.     pack $selFrame -side left -fill none -anchor nw
  293.     pack $topFrame -side top -expand yes -fill both -anchor nw
  294.  
  295.     # the botFrame frame contains the buttons
  296.     #
  297.     set botFrame [frame $w.bot -relief raised -bd 1]
  298.     
  299.     ::tk::AmpWidget button $botFrame.ok     -text [mc "&OK"]        \
  300.         -command [list tk::dialog::color::OkCmd $w]
  301.     ::tk::AmpWidget button $botFrame.cancel -text [mc "&Cancel"]    \
  302.         -command [list tk::dialog::color::CancelCmd $w]
  303.  
  304.     set data(okBtn)      $botFrame.ok
  305.     set data(cancelBtn)  $botFrame.cancel
  306.  
  307.     grid x $botFrame.ok x $botFrame.cancel x -sticky ew
  308.     grid configure $botFrame.ok $botFrame.cancel -padx 10 -pady 10
  309.     grid columnconfigure $botFrame {0 4} -weight 1 -uniform space
  310.     grid columnconfigure $botFrame {1 3} -weight 1 -uniform button
  311.     grid columnconfigure $botFrame 2 -weight 2 -uniform space
  312.     pack $botFrame -side bottom -fill x
  313.  
  314.  
  315.     # Accelerator bindings
  316.     bind $lab <<AltUnderlined>> [list focus $ent]
  317.     bind $w <KeyPress-Escape> [list tk::ButtonInvoke $data(cancelBtn)]
  318.     bind $w <Alt-Key> [list tk::AltKeyInDialog $w %A]
  319.  
  320.     wm protocol $w WM_DELETE_WINDOW [list tk::dialog::color::CancelCmd $w]
  321. }
  322.  
  323. # ::tk::dialog::color::SetRGBValue --
  324. #
  325. #    Sets the current selection of the dialog box
  326. #
  327. proc ::tk::dialog::color::SetRGBValue {w color} {
  328.     upvar ::tk::dialog::color::[winfo name $w] data 
  329.  
  330.     set data(red,intensity)   [lindex $color 0]
  331.     set data(green,intensity) [lindex $color 1]
  332.     set data(blue,intensity)  [lindex $color 2]
  333.     
  334.     RedrawColorBars $w all
  335.  
  336.     # Now compute the new x value of each colorbars pointer polygon
  337.     foreach color [list red green blue ] {
  338.     set x [RgbToX $w $data($color,intensity)]
  339.     MoveSelector $w $data($color,sel) $color $x 0
  340.     }
  341. }
  342.  
  343. # ::tk::dialog::color::XToRgb --
  344. #
  345. #    Converts a screen coordinate to intensity
  346. #
  347. proc ::tk::dialog::color::XToRgb {w x} {
  348.     upvar ::tk::dialog::color::[winfo name $w] data
  349.     
  350.     set x [expr {($x * $data(intensityIncr))/ $data(colorbarWidth)}]
  351.     if {$x > 255} { set x 255 }
  352.     return $x
  353. }
  354.  
  355. # ::tk::dialog::color::RgbToX
  356. #
  357. #    Converts an intensity to screen coordinate.
  358. #
  359. proc ::tk::dialog::color::RgbToX {w color} {
  360.     upvar ::tk::dialog::color::[winfo name $w] data
  361.     
  362.     return [expr {($color * $data(colorbarWidth)/ $data(intensityIncr))}]
  363. }
  364.  
  365.  
  366. # ::tk::dialog::color::DrawColorScale --
  367. # 
  368. #    Draw color scale is called whenever the size of one of the color
  369. #    scale canvases is changed.
  370. #
  371. proc ::tk::dialog::color::DrawColorScale {w c {create 0}} {
  372.     upvar ::tk::dialog::color::[winfo name $w] data
  373.  
  374.     # col: color bar canvas
  375.     # sel: selector canvas
  376.     set col $data($c,col)
  377.     set sel $data($c,sel)
  378.  
  379.     # First handle the case that we are creating everything for the first time.
  380.     if {$create} {
  381.     # First remove all the lines that already exist.
  382.     if { $data(lines,$c,last) > $data(lines,$c,start)} {
  383.         for {set i $data(lines,$c,start)} \
  384.         {$i <= $data(lines,$c,last)} { incr i} {
  385.         $sel delete $i
  386.         }
  387.     }
  388.     # Delete the selector if it exists
  389.     if {[info exists data($c,index)]} {
  390.         $sel delete $data($c,index)
  391.     }
  392.     
  393.     # Draw the selection polygons
  394.     CreateSelector $w $sel $c
  395.     $sel bind $data($c,index) <ButtonPress-1> \
  396.         [list tk::dialog::color::StartMove $w $sel $c %x $data(selPad) 1]
  397.     $sel bind $data($c,index) <B1-Motion> \
  398.         [list tk::dialog::color::MoveSelector $w $sel $c %x $data(selPad)]
  399.     $sel bind $data($c,index) <ButtonRelease-1> \
  400.         [list tk::dialog::color::ReleaseMouse $w $sel $c %x $data(selPad)]
  401.  
  402.     set height [winfo height $col]
  403.     # Create an invisible region under the colorstrip to catch mouse clicks
  404.     # that aren't on the selector.
  405.     set data($c,clickRegion) [$sel create rectangle 0 0 \
  406.         $data(canvasWidth) $height -fill {} -outline {}]
  407.  
  408.     bind $col <ButtonPress-1> \
  409.         [list tk::dialog::color::StartMove $w $sel $c %x $data(colorPad)]
  410.     bind $col <B1-Motion> \
  411.         [list tk::dialog::color::MoveSelector $w $sel $c %x $data(colorPad)]
  412.     bind $col <ButtonRelease-1> \
  413.         [list tk::dialog::color::ReleaseMouse $w $sel $c %x $data(colorPad)]
  414.  
  415.     $sel bind $data($c,clickRegion) <ButtonPress-1> \
  416.         [list tk::dialog::color::StartMove $w $sel $c %x $data(selPad)]
  417.     $sel bind $data($c,clickRegion) <B1-Motion> \
  418.         [list tk::dialog::color::MoveSelector $w $sel $c %x $data(selPad)]
  419.     $sel bind $data($c,clickRegion) <ButtonRelease-1> \
  420.         [list tk::dialog::color::ReleaseMouse $w $sel $c %x $data(selPad)]
  421.     } else {
  422.     # l is the canvas index of the first colorbar.
  423.     set l $data(lines,$c,start)
  424.     }
  425.     
  426.     # Draw the color bars.
  427.     set highlightW [expr {[$col cget -highlightthickness] + [$col cget -bd]}]
  428.     for {set i 0} { $i < $data(NUM_COLORBARS)} { incr i} {
  429.     set intensity [expr {$i * $data(intensityIncr)}]
  430.     set startx [expr {$i * $data(colorbarWidth) + $highlightW}]
  431.     if {$c eq "red"} {
  432.         set color [format "#%02x%02x%02x" \
  433.                $intensity \
  434.                $data(green,intensity) \
  435.                $data(blue,intensity)]
  436.     } elseif {$c eq "green"} {
  437.         set color [format "#%02x%02x%02x" \
  438.                $data(red,intensity) \
  439.                $intensity \
  440.                $data(blue,intensity)]
  441.     } else {
  442.         set color [format "#%02x%02x%02x" \
  443.                $data(red,intensity) \
  444.                $data(green,intensity) \
  445.                $intensity]
  446.     }
  447.  
  448.     if {$create} {
  449.         set index [$col create rect $startx $highlightW \
  450.             [expr {$startx +$data(colorbarWidth)}] \
  451.             [expr {[winfo height $col] + $highlightW}]\
  452.             -fill $color -outline $color]
  453.     } else {
  454.         $col itemconfigure $l -fill $color -outline $color
  455.         incr l
  456.     }
  457.     }
  458.     $sel raise $data($c,index)
  459.  
  460.     if {$create} {
  461.     set data(lines,$c,last) $index
  462.     set data(lines,$c,start) [expr {$index - $data(NUM_COLORBARS) + 1}]
  463.     }
  464.  
  465.     RedrawFinalColor $w
  466. }
  467.  
  468. # ::tk::dialog::color::CreateSelector --
  469. #
  470. #    Creates and draws the selector polygon at the position
  471. #    $data($c,intensity).
  472. #
  473. proc ::tk::dialog::color::CreateSelector {w sel c } {
  474.     upvar ::tk::dialog::color::[winfo name $w] data
  475.     set data($c,index) [$sel create polygon \
  476.     0 $data(PLGN_HEIGHT) \
  477.     $data(PLGN_WIDTH) $data(PLGN_HEIGHT) \
  478.     $data(indent) 0]
  479.     set data($c,x) [RgbToX $w $data($c,intensity)]
  480.     $sel move $data($c,index) $data($c,x) 0
  481. }
  482.  
  483. # ::tk::dialog::color::RedrawFinalColor
  484. #
  485. #    Combines the intensities of the three colors into the final color
  486. #
  487. proc ::tk::dialog::color::RedrawFinalColor {w} {
  488.     upvar ::tk::dialog::color::[winfo name $w] data
  489.  
  490.     set color [format "#%02x%02x%02x" $data(red,intensity) \
  491.     $data(green,intensity) $data(blue,intensity)]
  492.     
  493.     $data(finalCanvas) configure -bg $color
  494.     set data(finalColor) $color
  495.     set data(selection) $color
  496.     set data(finalRGB) [list \
  497.         $data(red,intensity) \
  498.         $data(green,intensity) \
  499.         $data(blue,intensity)]
  500. }
  501.  
  502. # ::tk::dialog::color::RedrawColorBars --
  503. #
  504. # Only redraws the colors on the color strips that were not manipulated.
  505. # Params: color of colorstrip that changed. If color is not [red|green|blue]
  506. #         Then all colorstrips will be updated
  507. #
  508. proc ::tk::dialog::color::RedrawColorBars {w colorChanged} {
  509.     upvar ::tk::dialog::color::[winfo name $w] data
  510.  
  511.     switch $colorChanged {
  512.     red { 
  513.         DrawColorScale $w green
  514.         DrawColorScale $w blue
  515.     }
  516.     green {
  517.         DrawColorScale $w red
  518.         DrawColorScale $w blue
  519.     }
  520.     blue {
  521.         DrawColorScale $w red
  522.         DrawColorScale $w green
  523.     }
  524.     default {
  525.         DrawColorScale $w red
  526.         DrawColorScale $w green
  527.         DrawColorScale $w blue
  528.     }
  529.     }
  530.     RedrawFinalColor $w
  531. }
  532.  
  533. #----------------------------------------------------------------------
  534. #            Event handlers
  535. #----------------------------------------------------------------------
  536.  
  537. # ::tk::dialog::color::StartMove --
  538. #
  539. #    Handles a mousedown button event over the selector polygon.
  540. #    Adds the bindings for moving the mouse while the button is
  541. #    pressed.  Sets the binding for the button-release event.
  542. # 
  543. # Params: sel is the selector canvas window, color is the color of the strip.
  544. #
  545. proc ::tk::dialog::color::StartMove {w sel color x delta {dontMove 0}} {
  546.     upvar ::tk::dialog::color::[winfo name $w] data
  547.  
  548.     if {!$dontMove} {
  549.     MoveSelector $w $sel $color $x $delta
  550.     }
  551. }
  552.  
  553. # ::tk::dialog::color::MoveSelector --
  554. # 
  555. # Moves the polygon selector so that its middle point has the same
  556. # x value as the specified x. If x is outside the bounds [0,255],
  557. # the selector is set to the closest endpoint.
  558. #
  559. # Params: sel is the selector canvas, c is [red|green|blue]
  560. #         x is a x-coordinate.
  561. #
  562. proc ::tk::dialog::color::MoveSelector {w sel color x delta} {
  563.     upvar ::tk::dialog::color::[winfo name $w] data
  564.  
  565.     incr x -$delta
  566.  
  567.     if { $x < 0 } {
  568.     set x 0
  569.     } elseif { $x > $data(BARS_WIDTH)} {
  570.     set x $data(BARS_WIDTH)
  571.     }
  572.     set diff [expr {$x - $data($color,x)}]
  573.     $sel move $data($color,index) $diff 0
  574.     set data($color,x) [expr {$data($color,x) + $diff}]
  575.     
  576.     # Return the x value that it was actually set at
  577.     return $x
  578. }
  579.  
  580. # ::tk::dialog::color::ReleaseMouse
  581. #
  582. # Removes mouse tracking bindings, updates the colorbars.
  583. #
  584. # Params: sel is the selector canvas, color is the color of the strip,
  585. #         x is the x-coord of the mouse.
  586. #
  587. proc ::tk::dialog::color::ReleaseMouse {w sel color x delta} {
  588.     upvar ::tk::dialog::color::[winfo name $w] data 
  589.  
  590.     set x [MoveSelector $w $sel $color $x $delta]
  591.     
  592.     # Determine exactly what color we are looking at.
  593.     set data($color,intensity) [XToRgb $w $x]
  594.  
  595.     RedrawColorBars $w $color
  596. }
  597.  
  598. # ::tk::dialog::color::ResizeColorbars --
  599. #
  600. #    Completely redraws the colorbars, including resizing the
  601. #    colorstrips
  602. #
  603. proc ::tk::dialog::color::ResizeColorBars {w} {
  604.     upvar ::tk::dialog::color::[winfo name $w] data
  605.     
  606.     if { ($data(BARS_WIDTH) < $data(NUM_COLORBARS)) || 
  607.      (($data(BARS_WIDTH) % $data(NUM_COLORBARS)) != 0)} {
  608.     set data(BARS_WIDTH) $data(NUM_COLORBARS)
  609.     }
  610.     InitValues [winfo name $w]
  611.     foreach color [list red green blue ] {
  612.     $data($color,col) configure -width $data(canvasWidth)
  613.     DrawColorScale $w $color 1
  614.     }
  615. }
  616.  
  617. # ::tk::dialog::color::HandleSelEntry --
  618. #
  619. #    Handles the return keypress event in the "Selection:" entry
  620. #
  621. proc ::tk::dialog::color::HandleSelEntry {w} {
  622.     upvar ::tk::dialog::color::[winfo name $w] data
  623.  
  624.     set text [string trim $data(selection)]
  625.     # Check to make sure that the color is valid
  626.     if {[catch {set color [winfo rgb . $text]} ]} {
  627.     set data(selection) $data(finalColor)
  628.     return
  629.     }
  630.     
  631.     set R [expr {[lindex $color 0]/0x100}]
  632.     set G [expr {[lindex $color 1]/0x100}]
  633.     set B [expr {[lindex $color 2]/0x100}]
  634.  
  635.     SetRGBValue $w "$R $G $B"
  636.     set data(selection) $text
  637. }
  638.  
  639. # ::tk::dialog::color::HandleRGBEntry --
  640. #
  641. #    Handles the return keypress event in the R, G or B entry
  642. #
  643. proc ::tk::dialog::color::HandleRGBEntry {w} {
  644.     upvar ::tk::dialog::color::[winfo name $w] data
  645.  
  646.     foreach c [list red green blue] {
  647.     if {[catch {
  648.         set data($c,intensity) [expr {int($data($c,intensity))}]
  649.     }]} {
  650.         set data($c,intensity) 0
  651.     }
  652.  
  653.     if {$data($c,intensity) < 0} {
  654.         set data($c,intensity) 0
  655.     }
  656.     if {$data($c,intensity) > 255} {
  657.         set data($c,intensity) 255
  658.     }
  659.     }
  660.  
  661.     SetRGBValue $w "$data(red,intensity) \
  662.     $data(green,intensity) $data(blue,intensity)"
  663. }    
  664.  
  665. # mouse cursor enters a color bar
  666. #
  667. proc ::tk::dialog::color::EnterColorBar {w color} {
  668.     upvar ::tk::dialog::color::[winfo name $w] data
  669.  
  670.     $data($color,sel) itemconfigure $data($color,index) -fill red
  671. }
  672.  
  673. # mouse leaves enters a color bar
  674. #
  675. proc ::tk::dialog::color::LeaveColorBar {w color} {
  676.     upvar ::tk::dialog::color::[winfo name $w] data
  677.  
  678.     $data($color,sel) itemconfigure $data($color,index) -fill black
  679. }
  680.  
  681. # user hits OK button
  682. #
  683. proc ::tk::dialog::color::OkCmd {w} {
  684.     variable ::tk::Priv
  685.     upvar ::tk::dialog::color::[winfo name $w] data
  686.  
  687.     set Priv(selectColor) $data(finalColor)
  688. }
  689.  
  690. # user hits Cancel button
  691. #
  692. proc ::tk::dialog::color::CancelCmd {w} {
  693.     variable ::tk::Priv
  694.     set Priv(selectColor) ""
  695. }
  696.  
  697.